home *** CD-ROM | disk | FTP | other *** search
/ Amiga Games: Greatest Hits 1996 / Amiga Games: Greatest Hits 1996.iso / spiele / publicdomain / ls-tron3.1 / maze.i < prev    next >
Text File  |  1996-04-30  |  19KB  |  587 lines
  1. { Maze.i }
  2.  
  3. {$I-}
  4.  
  5. PROCEDURE Load_Maze;
  6.  
  7.   CONST Err_Loesche_Length   =   1;
  8.         Err_Comment_2_Long   =   2;
  9.         Err_File_2_short     =   3;
  10.         Err_No_New_Paragraph =   4;
  11.         Err_Element_2_Long   =   5;
  12.         Err_File_Not_Complete=   6;
  13.         Err_No_Mem           =   7;
  14.         Err_File_Err         =   8;
  15.  
  16.         Err_Line_Length      =  20;
  17.         Err_Line_2_often     =  21;
  18.         Err_No_Line_Mem      =  22;
  19.         Err_Wrong_Coord      =  23;
  20.  
  21.         Err_Spieler_Length   =  30;
  22.         Err_Spieler_num      =  31;
  23.         Err_Spieler_posX     =  32;
  24.         Err_spieler_posY     =  33;
  25.         Err_Spieler_DirX     =  34;
  26.         Err_Spieler_DirY     =  35;
  27.  
  28.         Err_Level_Length     =  40;
  29.         Err_Wrong_Level      =  41;
  30.  
  31.   PROCEDURE Get_Errorstring(ErrNum : INTEGER;VAR errStr : String);
  32.  
  33.     BEGIN
  34.       IF Sprache=Deutsch THEN
  35.          BEGIN
  36.            CASE ErrNum OF
  37.               0 : StrCpy(ErrStr,"Kein Fehler!");
  38.               1 : StrCpy(errStr,"In #Loesche ist nur Länge 1 erlaubt!");
  39.               2 : StrCpy(errStr,"Zu große Anzahl für Zeilen in Kommentar angegeben!");
  40.               3 : StrCpy(errStr,"Datei zu kurz!");
  41.               4 : StrCpy(errStr,"Neuer Abschnitt (#) erwartet!");
  42.               5 : StrCpy(errStr,"Fehler in Zeile ???: Zu große Zeilenzahl angegeben!");
  43.               6 : StrCpy(errStr,"Datei konnte nicht vollständig geladen werden!");
  44.               7 : StrCpy(errStr,"Nicht genug Speicher vorhanden!");
  45.               8 : StrCpy(errStr,"Fehler in der Datei!");
  46.  
  47.              20 : StrCpy(errStr,"Die Länge von #Linien muß durch 5 teilbar sein!");
  48.              21 : StrCpy(errStr,"Der Abschnitt #Linien darf nur einmal pro Maze benutzt werden!");
  49.              22 : StrCpy(errStr,"Zu wenig Speicher für #Linien vorhanden!");
  50.              23 : StrCpy(errStr,"Wert ist nicht im richtigen Bereich!\nFarbe : 1-4\nX-Koordinate : 11-309\nY-Koordinate : 11-245");
  51.  
  52.              30 : StrCpy(errStr,"In #Spieler ist nur Länge 5 erlaubt!");
  53.              31 : StrCpy(errStr,"In #Spieler muß ein Spieler von 1-6 angegeben werden!");
  54.              32 : StrCpy(errStr,"In #Spieler muß die X-Position zwischen 10 und 310 liegen!");
  55.              33 : StrCpy(errStr,"In #Spieler muß die Y-Position zwischen 10 und 235 liegen!");
  56.              34 : StrCpy(errStr,"In #Spieler muß die X-Bewegung -1,0 oder 1 sein!");
  57.              35 : StrCpy(errStr,"In #Spieler muß die Y-Bewegung -1,0 oder 1 sein!");
  58.  
  59.              40 : StrCpy(errStr,"In #Level ist nur Länge 1 erlaubt!");
  60.              41 : StrCpy(errStr,"In #Level darf nur ein Wert von 0-5 stehen!");
  61.             ELSE StrCpy(ErrStr,"Unbekannter Fehler!");
  62.            END;
  63.          END
  64.         ELSE
  65.          BEGIN
  66.            CASE ErrNum OF
  67.               0 : StrCpy(ErrStr,"No Error!");
  68.               1 : StrCpy(errStr,"#Delete must have a length of 1!");
  69.               2 : StrCpy(errStr,"#Comment cannot be longer than the file!");
  70.               3 : StrCpy(errStr,"File to short!");
  71.               4 : StrCpy(errStr,"New paragraph (#) expected!");
  72.               5 : StrCpy(errStr,"Error in line ???: To big number of lines entered!");
  73.               6 : StrCpy(errStr,"Unable to load the complete maze!");
  74.               7 : StrCpy(errStr,"Not enough memory");
  75.               8 : StrCpy(errStr,"Error in file!");
  76.  
  77.              20 : StrCpy(errStr,"Length of #Linien must be a number, \nwhich can be divided by 5!");
  78.              21 : StrCpy(errStr,"#Lines mustn't appear more than one time in a maze-file!");
  79.              22 : StrCpy(errStr,"Not enough memory for #Linien!");
  80.              23 : StrCpy(errStr,"Value to big or to small!\nColour : 1-4\nX-Coord : 11-309\nY-Coord : 11-245");
  81.  
  82.              30 : StrCpy(errStr,"#Spieler must have a length of 5!");
  83.              31 : StrCpy(errStr,"In #Player the playernumber must be 1-6!");
  84.              32 : StrCpy(errStr,"In #Player the X-Coord must be 10-310");
  85.              33 : StrCpy(errStr,"In #Player the Y-Coord must be 10-235");
  86.              34 : StrCpy(errStr,"In #Player the X-Movement must be -1, 0 or 1!");
  87.              35 : StrCpy(errStr,"In #Player the Y-Movement must be -1, 0 or 1!");
  88.  
  89.              40 : StrCpy(errStr,"#Level must have a length of one line!");
  90.              41 : StrCpy(errStr,"In #Level only values between 0 and 5 inclusively are allowed!");
  91.             ELSE StrCpy(ErrStr,"Unknown Error!");
  92.            END;
  93.          END;
  94.     END;
  95.  
  96.   PROCEDURE UnLoad_Maze;
  97.  
  98.     VAR x : BYTE;
  99.  
  100.     BEGIN
  101.       WITH TBase^ DO
  102.         BEGIN
  103.           Use_Maze:=FALSE;
  104.           Maze_Loaded:=FALSE;
  105.         END;
  106.  
  107.       WITH TBase^.MyMaze DO
  108.         BEGIN
  109.           Loeschen:=TRUE;
  110.           IF LineNum>0 THEN
  111.              FreeMem(ADDRESS(Linien),LineNum*SizeOf(Linie));
  112.           LineNum:=0;
  113.           FOR x:=1 TO maxplay DO
  114.             players[x].ist_geladen:=FALSE;
  115.         END;
  116.     END;
  117.  
  118.   PROCEDURE Lade;
  119.  
  120.     PROCEDURE Error(error : INTEGER);
  121.  
  122.       VAR s : STRING;
  123.  
  124.       BEGIN
  125.         s:=ALLOCSTRING(150);
  126.         Get_Errorstring(error,s);
  127.  
  128.         IF error<>0 THEN
  129.            BEGIN
  130.              SetColours(TRUE);
  131.              Show(s);
  132.              ResetColours(TRUE);
  133.            END;
  134.  
  135.         FreeString(s);
  136.  
  137.         WITH TBase^.MyMaze DO
  138.           BEGIN
  139.             Loeschen:=TRUE;
  140.             IF Linien<>NIL THEN
  141.                BEGIN
  142.                  FreeMem(linien,SizeOf(Linie)*linenum);
  143.                  Linien:=NIL;
  144.                  LineNum:=0;
  145.                END;
  146.           END;
  147.  
  148.         TBase^.Use_Maze:=FALSE;
  149.         TBase^.Maze_Loaded:=FALSE;
  150.       END;
  151.  
  152.     FUNCTION CheckFile : INTEGER;
  153.  
  154.       VAR x,y   : INTEGER;
  155.           zeile : STRING;
  156.           t     : TEXT;
  157.  
  158.       BEGIN
  159.         x:=0;
  160.         y:=0;
  161.         zeile:=ALLOCSTRING(255);
  162.  
  163.         Reset(t,TBase^.MyMaze.MazeName);
  164.  
  165.         READLN(t,zeile);
  166.         x:=IOResult;
  167.         IF NOT StrIEq(zeile,"#LS-Tron Maze") THEN x:=-1;
  168.  
  169.         WHILE (NOT EOF(t)) AND (x=0) DO
  170.           BEGIN
  171.             READLN(t,zeile);
  172.             x:=IOResult;
  173.             inc(y);
  174.           END;
  175.         Close(t);
  176.  
  177.         FreeString(zeile);
  178.         IF x>=0 THEN Checkfile:=y
  179.                 ELSE Checkfile:=x;
  180.       END;
  181.  
  182.     VAR fehler : INTEGER;
  183.         Datei  : ^ARRAY[1..2] OF STRING;
  184.  
  185.     PROCEDURE FreeStrings(max : INTEGER);
  186.  
  187.       VAR x : INTEGER;
  188.  
  189.       BEGIN
  190.         FOR x:=1 TO max DO
  191.           FreeString(Datei^[x]);
  192.       END;
  193.  
  194.     FUNCTION AllocStrings : BOOLEAN;
  195.  
  196.       VAR x : INTEGER;
  197.  
  198.       BEGIN
  199.         FOR x:=1 TO fehler DO
  200.           Datei^[x]:=NIL;
  201.  
  202.         x:=0;
  203.  
  204.         REPEAT
  205.           inc(x);
  206.           Datei^[x]:=AllocString(255);
  207.         UNTIL (Datei^[x]=NIL) OR (x=fehler);
  208.  
  209.         IF Datei^[x]=NIL THEN FreeStrings(x-1);
  210.  
  211.         AllocStrings:=(Datei^[x]<>NIL);
  212.       END;
  213.  
  214.     FUNCTION LeseStrings : BOOLEAN;
  215.  
  216.       VAR t   : TEXT;
  217.           Ok  : BOOLEAN;
  218.           x,y : INTEGER;
  219.  
  220.       BEGIN
  221.         Reset(t,TBase^.MyMaze.MazeName);
  222.         x:=0;
  223.         y:=0;
  224.  
  225.         READLN(t,Datei^[1]);
  226.         x:=IOResult;
  227.  
  228.         WHILE NOT EOF(t) AND (x=0) AND (y<fehler) DO
  229.           BEGIN
  230.             inc(y);
  231.             READLN(t,Datei^[y]);
  232.             x:=IOResult;
  233.           END;
  234.  
  235.         Ok:=TRUE;
  236.         IF y<Fehler   THEN Ok:=FALSE;
  237.         IF x<>0       THEN Ok:=FALSE;
  238.         IF NOT EOF(t) THEN Ok:=FALSE;
  239.  
  240.         Close(t);
  241.  
  242.         LeseStrings:=Ok;
  243.       END;
  244.  
  245.     PROCEDURE Lese(maximum : INTEGER);
  246.  
  247.       VAR Zaehler : INTEGER;
  248.           ende    : BOOLEAN;
  249.  
  250.       PROCEDURE MyError(zeile,error : INTEGER);
  251.  
  252.         VAR st,st2 : STRING;
  253.  
  254.         BEGIN
  255.           st:=AllocString(255);
  256.           st2:=AllocString(150);
  257.  
  258.           Get_Errorstring(error,st2);
  259.  
  260.           IF Sprache=Deutsch THEN StrCpy(st,"Fehler in Zeile ")
  261.                              ELSE StrCpy(st,"Error in Line ");
  262.  
  263.           AddString(st,zeile);
  264.           StrCat(st,":\n");
  265.  
  266.           StrCat(st,st2);
  267.  
  268.           FreeString(st2);
  269.  
  270.           SetColours(TRUE);
  271.           Show(st);
  272.           ResetColours(TRUE);
  273.  
  274.           WITH TBase^.MyMaze DO
  275.             BEGIN
  276.               Loeschen:=TRUE;
  277.               IF Linien<>NIL THEN
  278.                  BEGIN
  279.                    FreeMem(linien,SizeOf(Linie)*linenum);
  280.                    Linien:=NIL;
  281.                    LineNum:=0;
  282.                  END;
  283.             END;
  284.  
  285.           TBase^.Use_Maze:=FALSE;
  286.           TBase^.Maze_Loaded:=FALSE;
  287.           ende:=TRUE;
  288.  
  289.           FreeString(st);
  290.         END;
  291.  
  292.       PROCEDURE Bearbeite;
  293.  
  294.         PROCEDURE Springe;
  295.  
  296.           VAR x : INTEGER;
  297.  
  298.           BEGIN
  299.             inc(zaehler);
  300.             x:=Str2Int(Datei^[zaehler]);
  301.             zaehler:=zaehler+x;
  302.           END;
  303.  
  304.         PROCEDURE Load_Lines;
  305.  
  306.           VAR x      : INTEGER;
  307.               weiter : BOOLEAN;
  308.  
  309.           BEGIN
  310.             inc(zaehler);
  311.             IF Str2Int(Datei^[zaehler]) MOD 5<>0 THEN MyError(zaehler,Err_Line_Length)
  312.                                                  ELSE
  313.                BEGIN
  314.                  WITH TBase^.MyMaze DO
  315.                    BEGIN
  316.                      IF LineNum>0 THEN MyError(zaehler-1,Err_Line_2_often)
  317.                        ELSE
  318.                         BEGIN
  319.                           LineNum:=Str2Int(Datei^[zaehler]) DIV 5;
  320.  
  321.                           Linien:=NIL;
  322.                           Linien:=AllocMem(LineNum*SizeOf(Linie),MEMF_PUBLIC);
  323.                           IF Linien=NIL THEN Error(Err_No_Line_Mem)
  324.                                         ELSE
  325.                              BEGIN
  326.                                x:=1;
  327.                                weiter:=TRUE;
  328.                                WHILE (x<=LineNum) AND weiter DO
  329.                                  BEGIN
  330.                                    WITH Linien^[x] DO
  331.                                      BEGIN
  332.                                        inc(zaehler);
  333.                                        colour:=Str2Int(Datei^[zaehler]);
  334.                                        CASE Colour OF
  335.                                          0 : colour:=1;
  336.                                          1 : colour:=12;
  337.                                          2 : colour:=11;
  338.                                          3 : colour:=10;
  339.                                         ELSE Weiter:=FALSE;
  340.                                        END;
  341.                                        IF weiter THEN
  342.                                           BEGIN
  343.                                             inc(zaehler);
  344.                                             x1:=Str2Int(Datei^[zaehler]);
  345.                                             IF (x1<11) OR (x1>309) THEN Weiter:=FALSE;
  346.                                           END;
  347.                                        IF weiter THEN
  348.                                           BEGIN
  349.                                             inc(zaehler);
  350.                                             y1:=Str2Int(Datei^[zaehler]);
  351.                                             IF (y1<11) OR (y1>245) THEN Weiter:=FALSE;
  352.                                           END;
  353.                                        IF weiter THEN
  354.                                           BEGIN
  355.                                             inc(zaehler);
  356.                                             x2:=Str2Int(Datei^[zaehler]);
  357.                                             IF (x2<11) OR (x2>309) THEN Weiter:=FALSE;
  358.                                           END;
  359.                                        IF weiter THEN
  360.                                           BEGIN
  361.                                             inc(zaehler);
  362.                                             y2:=Str2Int(Datei^[zaehler]);
  363.                                             IF (y2<11) OR (y2>245) THEN Weiter:=FALSE;
  364.                                           END;
  365.                                      END;
  366.                                    inc(x);
  367.                                  END;
  368.                                IF NOT Weiter THEN MyError(zaehler,Err_Wrong_Coord);
  369.                              END;
  370.                         END;
  371.                    END;
  372.                END;
  373.           END;
  374.  
  375.         PROCEDURE Set_Player;
  376.  
  377.           VAR spieler,x,y,mx,my : SHORT;
  378.  
  379.           BEGIN
  380.             inc(zaehler);
  381.             IF Str2Int(Datei^[zaehler])<>5 THEN MyError(zaehler,Err_Spieler_Length)
  382.                                            ELSE
  383.              BEGIN
  384.                Spieler:=Str2Int(Datei^[zaehler+1]);
  385.                x      :=Str2Int(Datei^[zaehler+2]);
  386.                y      :=Str2Int(Datei^[zaehler+3]);
  387.                mx     :=Str2Int(Datei^[zaehler+4]);
  388.                my     :=Str2Int(Datei^[zaehler+5]);
  389.  
  390.                IF (spieler<1) OR (spieler>maxplay) THEN MyError(zaehler+1,Err_Spieler_Num)
  391.                                                    ELSE
  392.                 BEGIN
  393.                   IF (x<11) OR (x>309) THEN MyError(zaehler+2,Err_Spieler_PosX)
  394.                                        ELSE
  395.                    BEGIN
  396.                      IF (y<11) OR (y>234) THEN MyError(zaehler+3,Err_Spieler_PosY)
  397.                                           ELSE
  398.                       BEGIN
  399.                         IF (ABS(mx)>1) THEN MyError(zaehler+4,Err_Spieler_DirX)
  400.                                        ELSE
  401.                          BEGIN
  402.                            IF (ABS(my)>1) THEN MyError(zaehler+5,Err_Spieler_DirY)
  403.                                           ELSE
  404.                             BEGIN
  405.                               WITH TBase^.MyMaze.Players[spieler] DO
  406.                                 BEGIN
  407.                                   Ist_geladen:=TRUE;
  408.                                   pos.x      :=x   ;
  409.                                   pos.y      :=y   ;
  410.                                   Bewegung.x :=mx  ;
  411.                                   Bewegung.y :=my  ;
  412.                                 END;
  413.                             END;
  414.                          END;
  415.                       END;
  416.                    END;
  417.                 END;
  418.              END;
  419.             zaehler:=zaehler+5;
  420.           END;
  421.  
  422.         PROCEDURE Set_Level;
  423.  
  424.           VAR Level : SHORT;
  425.  
  426.           BEGIN
  427.             inc(zaehler);
  428.             IF Str2Int(Datei^[zaehler])<>1 THEN MyError(zaehler,Err_Level_Length)
  429.                                            ELSE
  430.                BEGIN
  431.                  inc(zaehler);
  432.                  level:=Str2Int(Datei^[zaehler]);
  433.                  IF (Level<VeryEasy) OR
  434.                     (Level>suicide ) THEN MyError(zaehler,Err_Wrong_Level)
  435.                                      ELSE TBase^.Level:=Level;
  436.                END;
  437.           END;
  438.  
  439.         PROCEDURE Set_Loesche;
  440.  
  441.           BEGIN
  442.             inc(zaehler);
  443.             IF Str2Int(Datei^[zaehler])<>1 THEN MyError(zaehler,Err_Loesche_Length)
  444.                                            ELSE
  445.                BEGIN
  446.                  inc(zaehler);
  447.                  IF StrIEq(Datei^[zaehler],"Ja") THEN
  448.                     TBase^.MyMaze.Loeschen:=TRUE
  449.                    ELSE
  450.                     IF StrIEq(Datei^[zaehler],"Yes") THEN
  451.                        TBase^.MyMaze.Loeschen:=TRUE
  452.                       ELSE
  453.                        TBase^.MyMaze.Loeschen:=FALSE;
  454.                END;
  455.           END;
  456.  
  457.         PROCEDURE Set_Comment;
  458.  
  459.           VAR x,y : INTEGER;
  460.  
  461.           BEGIN
  462.             inc(zaehler);
  463.             x:=Str2Int(Datei^[zaehler]);
  464.             IF x+zaehler<=maximum THEN
  465.                BEGIN
  466.                  SetColours(TRUE);
  467.                  FOR y:=1 TO x DO
  468.                  Show(Datei^[zaehler+y]);
  469.                  ResetColours(TRUE);
  470.                END
  471.               ELSE MyError(zaehler,Err_Comment_2_Long);
  472.  
  473.             zaehler:=zaehler+x;
  474.           END;
  475.  
  476.         BEGIN
  477.           IF maximum-zaehler>1 THEN
  478.            BEGIN
  479.              IF StrIEq(Datei^[zaehler],"#Linien") THEN Load_Lines
  480.               ELSE
  481.               IF StrIEq(Datei^[zaehler],"#Spieler") THEN Set_Player
  482.                ELSE
  483.                IF StrIEq(Datei^[zaehler],"#Level") THEN Set_Level
  484.                 ELSE
  485.                 IF StrIEq(Datei^[zaehler],"#Lösche") THEN Set_Loesche
  486.                  ELSE
  487.                  IF StrIEq(Datei^[zaehler],"#Kommentar") THEN Set_Comment
  488.                   ELSE
  489.                   IF StrIEq(Datei^[zaehler],"#Lines") THEN Load_Lines
  490.                    ELSE
  491.                    IF StrIEq(Datei^[zaehler],"#Player") THEN Set_Player
  492.                     ELSE
  493.                     IF StrIEq(Datei^[zaehler],"#Delete") THEN Set_Loesche
  494.                      ELSE
  495.                      IF StrIEq(Datei^[zaehler],"#Comment") THEN Set_Comment
  496.                       ELSE Springe;
  497.            END
  498.            ELSE MyError(zaehler,Err_File_2_Short);
  499.         END;
  500.  
  501.       VAR oldMax : INTEGER;
  502.  
  503.       BEGIN
  504.         oldMax:=maximum;
  505.  
  506.         WHILE StrLen(Datei^[maximum])=0 DO
  507.           maximum:=maximum-1;
  508.  
  509.         Zaehler:=0;
  510.         ende:=FALSE;
  511.         REPEAT
  512.           inc(zaehler);
  513.           IF StrNEq(Datei^[zaehler],"#",1) THEN Bearbeite
  514.                                            ELSE MyError(zaehler,Err_No_New_Paragraph);
  515.         UNTIL (Zaehler>=Maximum) OR ende;
  516.         IF zaehler>OldMax THEN Error(Err_Element_2_Long);
  517.       END;
  518.  
  519.     BEGIN
  520.       WITH TBase^ DO
  521.         BEGIN
  522.           Use_Maze:=TRUE;
  523.           Maze_Loaded:=TRUE;
  524.         END;
  525.  
  526.       SetColours(TRUE);
  527.       WITH TBase^.MyMaze DO
  528.         FileRequest("Lade Labyrinth",MazeDir,MazeName);
  529.       ResetColours(TRUE);
  530.  
  531.       IF StrLen(TBase^.MyMaze.MazeDir)+1>=StrLen(TBase^.MyMaze.MazeName) THEN Error(0)
  532.                                                                          ELSE
  533.          BEGIN
  534.            Fehler:=CheckFile;
  535.            IF Fehler<=0 THEN Error(Err_File_Not_Complete)
  536.                         ELSE
  537.              BEGIN
  538.                 Datei:=NIL;
  539.                 Datei:=AllocMem(fehler*SizeOf(STRING),MEMF_PUBLIC);
  540.                 IF Datei=NIL THEN Error(Err_No_Mem)
  541.                              ELSE
  542.                    BEGIN
  543.                      IF NOT AllocStrings THEN Error(Err_No_Mem)
  544.                                          ELSE
  545.                         BEGIN
  546.                           IF NOT LeseStrings THEN Error(Err_File_Err)
  547.                                              ELSE Lese(fehler);
  548.                           FreeStrings(fehler);
  549.                         END;
  550.                      FreeMem(Datei,fehler*SizeOf(String));
  551.                    END;
  552.              END;
  553.          END;
  554.  
  555.       IF TBase^.Maze_Loaded THEN
  556.          BEGIN
  557.            IF Sprache=Deutsch THEN Show("Labyrinth erfolgreich geladen!")
  558.                               ELSE Show("Maze has been loaded succesfully!");
  559.          END;
  560.     END;
  561.  
  562.   FUNCTION Sicherheitsabfrage : BOOLEAN;
  563.  
  564.     BEGIN
  565.       IF Sprache=Deutsch THEN
  566.          Sicherheitsabfrage:=Ask("Geladenes Labyrinth geht verloren!")
  567.         ELSE
  568.          Sicherheitsabfrage:=Ask("Current Maze will be lost!");
  569.     END;
  570.  
  571.   BEGIN
  572.     IF TBase^.Maze_loaded THEN
  573.        BEGIN
  574.          SetColours(TRUE);
  575.          IF Sicherheitsabfrage THEN
  576.             BEGIN
  577.               Unload_Maze;
  578.  
  579.               Lade;
  580.             END;
  581.          ResetColours(TRUE);
  582.        END
  583.       ELSE Lade;
  584.   END;
  585.  
  586. {$I+}
  587.